home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist00.zoo / init.lsp next >
Encoding:
Lisp/Scheme  |  1991-05-04  |  1.9 KB  |  64 lines
  1. ; initialization file for XLISP 2.0
  2.  
  3. (unless (fboundp 'strcat) ; backwards compatibility if COMMONLISP defined
  4.     (defmacro strcat (&rest str) `(concatenate 'string ,@str)))
  5.  
  6.  
  7. ; define some macros
  8. (defmacro defvar (sym &optional val)
  9.   `(if (boundp ',sym) ,sym (setq ,sym ,val)))
  10. (defmacro defparameter (sym val)
  11.   `(setq ,sym ,val))
  12. (defmacro defconstant (sym val)
  13.   `(setq ,sym ,val))
  14.  
  15. ; (makunbound sym) - make a symbol value be unbound
  16. (defun makunbound (sym) (setf (symbol-value sym) '*unbound*) sym)
  17.  
  18. ; (fmakunbound sym) - make a symbol function be unbound
  19. (defun fmakunbound (sym) (setf (symbol-function sym) '*unbound*) sym)
  20.  
  21. ; (mapcan fun list [ list ]...)
  22. (defmacro mapcan (&rest args) `(apply #'nconc (mapcar ,@args)))
  23.  
  24. ; (mapcon fun list [ list ]...)
  25. (defmacro mapcon (&rest args) `(apply #'nconc (maplist ,@args)))
  26.  
  27. ; (set-macro-character ch fun [ tflag ])
  28. (defun set-macro-character (ch fun &optional tflag)
  29.     (setf (aref *readtable* (char-int ch))
  30.           (cons (if tflag :tmacro :nmacro) fun))
  31.     t)
  32.  
  33. ; (get-macro-character ch)
  34. (defun get-macro-character (ch)
  35.   (if (consp (aref *readtable* (char-int ch)))
  36.     (cdr (aref *readtable* (char-int ch)))
  37.     nil))
  38.  
  39. ; (savefun fun) - save a function definition to a file
  40. (defmacro savefun (fun)
  41.   `(let* ((fname (strcat (symbol-name ',fun) ".lsp"))
  42.           (fval (get-lambda-expression (symbol-function ',fun)))
  43.           (fp (open fname :direction :output)))
  44.      (cond (fp (print (cons (if (eq (car fval) 'lambda)
  45.                                 'defun
  46.                                 'defmacro)
  47.                             (cons ',fun (cdr fval))) fp)
  48.                (close fp)
  49.                fname)
  50.            (t nil))))
  51.  
  52. ; (debug) - enable debug breaks
  53. (defun debug ()
  54.        (setq *breakenable* t))
  55.  
  56. ; (nodebug) - disable debug breaks
  57. (defun nodebug ()
  58.        (setq *breakenable* nil))
  59.  
  60. ; initialize to enable breaks but no trace back
  61. (setq *breakenable* t)
  62. (setq *tracenable* nil)
  63.  
  64.